perm filename BGEN.F4[JC,MUS]1 blob sn#078110 filedate 1973-12-18 generic text, type T, neo UTF8
00100	
00200		SUBROUTINE GEN(FUN)
00300	C  AFTER 'SYNTH(F1);'  TYPE 99= TO USE  H,A,P,K: ALL OTHER
00400	C   NUMBERS = H,A ONLY.  TYPE 999 TO END. NORMALIZATION IS AUTOMATIC.
00500		DIMENSION FUN(100)
00600		COMMON FREQ(3,0/50,100),FUNC(100),AMP(100),II(1),IJJ(4000)
00700		TYPE 1002
00800	1002	FORMAT(' 0 TO CLEAR ELSE 1'/)
00900		ACCEPT 201,AB
01000		IF(AB.NE.0.0)GO TO 1001
01100		DO 15 I=1,100
01200	15	FUN(I)=0.0
01300	201	FORMAT(4F)
01400	1001	FAC=360./100.
01500	16	CALL DPYSET(1,IJJ,3000)
01600		CALL ALINE(0,0,200,0)
01700		CALL ALINE(0,100,0,0)
01800		TYPE 445
01900	445	FORMAT(' TYPE H,A,P,K OR 999'/)
02000		ACCEPT 201,H,AMPL,X,CON
02100		IF(H.EQ.999.)GO TO 446
02200		X=X*100./360.	
02300	2016	DO 17 J=1,100
02400		XK=SIND(X*FAC)*AMPL+CON
02500		IF(CON.LT.100.0)GO TO 1
02600		FUN(J)=(XK-100.)*FUN(J)
02700		GO TO 2
02800	1	FUN(J)=FUN(J)+XK
02900	2	X=X+H
03000		IY=FUN(J)*100.
03100		IX=J*2
03200		CALL AVECT(IX,IY)
03300		IF(X.LE.50.)GO TO 17
03400		X=X-100.
03500	17	CONTINUE
03600		CALL DPYOUT(1)
03700		GO TO 16
03800	446	CALL DPYSET(1,IJJ,3000)
03900		CALL ALINE(0,0,200,0)
04000		CALL ALINE(0,100,0,0)
04100	2200	X=FUN(1)
04200		DO 19 I=2,100
04300		H=ABS(FUN(I))
04400	19	IF(X.LT.H)X=H
04500		DO 20 I=1,100
04600		FUN(I)=FUN(I)/X
04700		IY=FUN(I)*100.
04800		IX=(I-1)*2
04900	20	CALL AVECT(IX,IY)
05000		CALL DPYOUT(1)
05100		PAUSE
05200		CALL HYDPOG(1)
05300		RETURN
05400		END